home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 11 / FM Towns Free Software Collection 11.iso / t_os / tool / morse / morse.bas next >
BASIC Source File  |  1995-08-12  |  5KB  |  201 lines
  1. 10 SCREEN 0
  2. 20 CLS
  3. 30 SH=20
  4. 40 GOSUB 920
  5. 50 L=200
  6. 60 C=0
  7. 70 CC$=""
  8. 80 PC$=""
  9. 90 LIN=0
  10. 100 MIC=1
  11. 110 BC=0
  12. 120 S=0
  13. 130 K=2
  14. 140 AW=0
  15. 150 OUT &H04E8,0
  16. 160 OUT &H04E1,8
  17. 170 OUT &H04E0,&H3F
  18. 180 OUT &H04E1,9
  19. 190 OUT &H04E0,&H3F
  20. 200 OUT &H04E3,14
  21. 210 OUT &H04E2,&H3F
  22. 220 F=0
  23. 230 CHR%=0
  24. 240 WHILE S<SH AND BC<L*7
  25. 250   BC=BC+1
  26. 260   Y=ABS(INP(&H04E7)-128)
  27. 270   LINE(320,8)-(340,8),PSET,0
  28. 280   LINE(320,8)-(320+ABS(Y)/128*20,8),PSET,4
  29. 290   IF Y>X THEN S=Y:X=(Y*3+X)/4 ELSE S=X:X=(Y+X*3)/4
  30. 300   IF PTRIG(2)=1 THEN BEEP 1 ELSE BEEP 0
  31. 310 WEND
  32. 320 IF F>=8 THEN
  33. 330   PC$=CC$
  34. 340   CC$=T$(CHR%,AW)
  35. 350   PRINT CC$;
  36. 360   F=0
  37. 370   CHR%=0
  38. 380   IF CC$="[ﾜﾌﾞﾝ]" THEN
  39. 385     AW=0
  40. 390     GOSUB 1310
  41. 400   ELSE IF CC$="[ｵｳﾌﾞﾝ]" THEN
  42. 405     AW=1
  43. 410     GOSUB 1310
  44. 420   ENDIF
  45. 430   GOTO 730
  46. 440 ENDIF
  47. 450 IF BC<5 THEN C=C+BC:GOTO 810
  48. 460 IF C<L*K THEN
  49. 470   CHR%=3^F+CHR%:L=(L+C)/2
  50. 480 ELSE
  51. 490   CHR%=2*(3^F)+CHR%:L=(L+C/3)/2
  52. 500 ENDIF
  53. 510 IF BC<L*K THEN
  54. 520   F=F+1
  55. 530   GOTO 800
  56. 540 ELSE IF BC<L*4 THEN
  57. 550   PC$=CC$
  58. 560   CC$=T$(CHR%,AW)
  59. 570   PRINT CC$;
  60. 580   F=0
  61. 590   CHR%=0
  62. 591   IF CC$="[ﾎﾚ]" THEN
  63. 592     AW=0
  64. 593     GOSUB 1310
  65. 594   ELSE IF CC$="[ﾗﾀ]" THEN
  66. 595     AW=1
  67. 596     GOSUB 1310
  68. 597   ENDIF
  69. 600   GOTO 800
  70. 610 ELSE
  71. 620   PC$=CC$
  72. 630   CC$=" "
  73. 640   PRINT T$(CHR%,AW);CC$;
  74. 650   F=0
  75. 660   IF T$(CHR%,AW)="K" THEN
  76. 670     IF PC$=" " THEN PRINT
  77. 691   ELSE IF T$(CHR%,AW)="[ﾎﾚ]" THEN
  78. 692     AW=0
  79. 693     GOSUB 1310
  80. 694   ELSE IF T$(CHR%,AW)="[ﾗﾀ]" THEN
  81. 695     AW=1
  82. 696     GOSUB 1310
  83. 700   ENDIF
  84. 710   CHR%=0
  85. 720 ENDIF
  86. 730 WHILE S<SH
  87. 740   Y=ABS(INP(&H04E7)-128)
  88. 750   LINE(320,8)-(340,8),PSET,0
  89. 760   LINE(320,8)-(320+ABS(Y)/128*20,8),PSET,4
  90. 770   IF Y>X THEN S=Y:X=(Y*3+X)/4 ELSE S=X:X=(Y+X*3)/4
  91. 780   IF PTRIG(2)=1 THEN BEEP 1 ELSE BEEP 0
  92. 790 WEND
  93. 800 C=0
  94. 810 BC=0
  95. 820 WHILE S>=SH
  96. 830   C=C+1
  97. 840   Y=ABS(INP(&H04E7)-128)
  98. 850   LINE(320,8)-(340,8),PSET,0
  99. 860   LINE(320,8)-(320+ABS(Y)/128*20,8),PSET,4
  100. 870   IF Y>X THEN S=Y:X=(Y*3+X)/4 ELSE S=X:X=(Y+X*3)/4
  101. 880   IF PTRIG(2)=1 THEN BEEP 1 ELSE BEEP 0
  102. 890 WEND
  103. 900 IF C<3 THEN C=0:GOTO 730
  104. 910 GOTO 240
  105. 920 PRINT "Now preparing."
  106. 930 DIM T$(6561,1)
  107. 940 FOR I=0 TO 6561
  108. 950   FOR J=0 TO 1
  109. 960   T$(I,J)="$"
  110. 970   NEXT J
  111. 980 NEXT I
  112. 990 OPEN "I",#1,"morse.dat"
  113. 1000 FOR AW=0 TO 1
  114. 1010   INPUT#1,C$,CODE$
  115. 1020   WHILE C$<>"@@@"
  116. 1030     CODEN=0
  117. 1040     LC=LEN(CODE$)
  118. 1050     FOR I=0 TO LC-1
  119. 1060       IF "."=RIGHT$(LEFT$(CODE$,I+1),1) THEN N=1 ELSE N=2
  120. 1070       CODEN=N*(3^I)+CODEN
  121. 1080     NEXT I
  122. 1090     T$(CODEN,AW)=C$
  123. 1100     INPUT#1,C$,CODE$
  124. 1110   WEND
  125. 1120 NEXT AW
  126. 1130 CLOSE#1
  127. 1140 CONSOLE 1,24,0
  128. 1150 LOCATE 0,0,0:PRINT "文字(PF1):欧文 閾値(PF4 0<->10 PF5):";INT(SH/128*10);"     MIC(PF6):ON  LINE(PF7):OFF 終了(PF9)"
  129. 1160 LINE(320+SH/128*20,7)-(320+SH/128*20,9),PSET,7
  130. 1170 LOCATE 0,1
  131. 1180 ON KEY(1) GOSUB 1310
  132. 1190 ON KEY(4) GOSUB 1410
  133. 1200 ON KEY(5) GOSUB 1480
  134. 1210 ON KEY(6) GOSUB 1550
  135. 1220 ON KEY(7) GOSUB 1690
  136. 1230 ON KEY(9) GOSUB 1870
  137. 1240 KEY(1) ON
  138. 1250 KEY(4) ON
  139. 1260 KEY(5) ON
  140. 1270 KEY(6) ON
  141. 1280 KEY(7) ON
  142. 1290 KEY(9) ON
  143. 1300 RETURN
  144. 1310 XX=POS(0):YY=CSRLIN
  145. 1320 IF AW=0 THEN
  146. 1330   AW=1
  147. 1340   LOCATE 10,0,0:PRINT "和文"
  148. 1350 ELSE
  149. 1360   AW=0
  150. 1370   LOCATE 10,0,0:PRINT "欧文"
  151. 1380 ENDIF
  152. 1390 LOCATE XX,YY
  153. 1400 RETURN
  154. 1410 XX=POS(0):YY=CSRLIN
  155. 1420 LINE(320+SH/128*20,7)-(320+SH/128*20,9),PSET,0
  156. 1430 SH=SH-1:IF SH<=0 THEN SH=0
  157. 1440 LOCATE 36,0,0:PRINT INT(SH/128*10);" "
  158. 1450 LOCATE XX,YY
  159. 1460 LINE(320+SH/128*20,7)-(320+SH/128*20,9),PSET,7
  160. 1470 RETURN
  161. 1480 XX=POS(0):YY=CSRLIN
  162. 1490 LINE(320+SH/128*20,7)-(320+SH/128*20,9),PSET,0
  163. 1500 SH=SH+1:IF SH>=128 THEN SH=128
  164. 1510 LOCATE 36,0,0:PRINT INT(SH/128*10);" "
  165. 1520 LOCATE XX,YY
  166. 1530 LINE(320+SH/128*20,7)-(320+SH/128*20,9),PSET,7
  167. 1540 RETURN
  168. 1550 XX=POS(0):YY=CSRLIN
  169. 1560 IF MIC=1 THEN
  170. 1570   OUT &H04E3,10
  171. 1580   OUT &H04E2,&H3F
  172. 1590   MIC=0
  173. 1600   LOCATE 53,0,0:PRINT "OFF"
  174. 1610 ELSE
  175. 1620   OUT &H04E3,14
  176. 1630   OUT &H04E2,&H3F
  177. 1640   MIC=1
  178. 1650   LOCATE 53,0,0:PRINT "ON "
  179. 1660 ENDIF
  180. 1670 LOCATE XX,YY
  181. 1680 RETURN
  182. 1690 XX=POS(0):YY=CSRLIN
  183. 1700 IF LIN=1 THEN
  184. 1710   OUT &H04E1,8
  185. 1720   OUT &H04E0,&H3F
  186. 1730   OUT &H04E1,9
  187. 1740   OUT &H04E0,&H3F
  188. 1750   LIN=0
  189. 1760   LOCATE 67,0,0:PRINT "OFF"
  190. 1770 ELSE
  191. 1780   OUT &H04E1,12
  192. 1790   OUT &H04E0,&H3F
  193. 1800   OUT &H04E1,13
  194. 1810   OUT &H04E0,&H3F
  195. 1820   LIN=1
  196. 1830   LOCATE 67,0,0:PRINT "ON "
  197. 1840 ENDIF
  198. 1850 LOCATE XX,YY
  199. 1860 RETURN
  200. 1870 END
  201.